perm filename III.FAI[4,BGB] blob
sn#013953 filedate 1972-11-29 generic text, type T, neo UTF8
00100 TITLE III
00200 ; -- DISPLAY SUBROUTINES -- NOVEMBER 1972.
00300
00400 ;DISPLAY UUO CODES.
00500 OPDEF DPYPOS [XWD 702100,0]
00600 OPDEF DPYSIZ [XWD 702140,0]
00700 OPDEF DPYCLR [XWD 701000,0]
00800 OPDEF UPG [XWD 703000,0]
00900 OPDEF GETLIN [TTYUUO 6,]
01000
01100
01200 A←1
01300 B←2
01400 C←3
01500
01600 SP←16
01700
01800
01900 INTERNAL DPYSET,AIVECT,AVECT,APT,RIVECT,RVECT,RPT
02000 INTERNAL APOINT,RPOINT
02100 INTERNAL DPYOUT,HYDPOG
02200 INTERNAL DPYCLR,DPYBIG,DPYBRT,DPYRESET,DPYPARS
02300 INTERNAL CLRBFR,DTYO,DPYSST
02400
02500 RV←←6
02600 AVCO←←106
02700 VIS←←0
02800 EP←←20
02900 INV←←40
03000 SVS←100
03100 SV←2
03200
03300 DEFINE COMPAT(N)<POP P,RETURN↔JSP COMP-N>
03400
03500 POP P,5
03600 POP P,4
03700 POP P,3
03800 POP P,2
03900 POP P,1
04000 COMP: JRST @0
00100 ;EXTERNAL PROCEDURE AIVECT(INTEGER X,Y)
00200 ;EXTERNAL PROCEDURE AVECT(INTEGER X,Y)
00300 ;EXTERNAL PROCEDURE APT(INTEGER X,Y)
00400 AIVECT: MOVEI C,INV+AVCO
00500 GO LV
00600 AVECT: MOVEI C,VIS+AVCO
00700 GO LV
00800 APOINT:
00900 APT: MOVEI C,EP+AVCO
01000 LV: COMPAT(2)
01100 SKIPGE IGNORE↔GO @RETURN
01200 LVC: DPB A,[POINT 11,C,10]
01300 DPB B,[POINT 11,C,21]
01400 LV2: AOS A,DPYPTR
01500 DAC C,(A)
01600 LV3: HRLI A,<(<POINT 7,0,35>)>
01700 DAC A,DPYPTR
01800 HRRZI A,(A)
01900 CAML A,BUFEND
02000 SETOM IGNORE
02100 GO @RETURN
00100 ;EXTERNAL PROCEDURE RIVECT(INTEGER X,Y)
00200 ;EXTERNAL PROCEDURE RVECT(INTEGER X,Y)
00300 ;EXTERNAL PROCEDURE RPT(INTEGER X,Y)
00400 RIVECT: MOVEI C,INV+RV
00500 GO RVG
00600 RVECT: MOVEI C,VIS+RV
00700 GO RVG
00800 RPOINT:
00900 RPT: MOVEI C,EP+RV
01000 RVG: COMPAT(2)
01100 SKIPE RELFLG#
01200 GO LVC
01300 CAML A,[-SVS]
01400 CAIL A,SVS
01500 GO LVC
01600 CAML B,[-SVS]
01700 CAIL B,SVS
01800 GO LVC
01900 ANDCMI C,RV ;CAN CONSTRUCT SHORT VECTOR
02000 DPB A,[POINT 7,C,22]
02100 DPB B,[POINT 7,C,29]
02200 LSH C,20
02300 ORI C,SV+INV ;MAKE 2ND VECTORE INVISIBLE - ZERO LENGTH
02400 LAC A,@DPYPTR
02500 TLZ A,777774
02600 CAIE A,(C);WAS LAST DPY OUTPUT HALF A SHORT VECTOR.
02700 GO LV2 ;NO
02800 LSH C,-24 ;YES, PUT IT THERE
02900 DPB C,[POINT 16,@DPYPTR,31]
03000 HRRZ A,DPYPTR
03100 GO @RETURN
03200
03300 INTERNAL NORELOPT,RELOPT
03400 NORELOPT:SETOM RELFLG
03500 POPJ P,
03600
03700 RELOPT: SETZM RELFLG
03800 POPJ P,
00100 ;EXTERNAL PROCEDURE DTYO(INTEGER CHAR)
00200 ;EXTERNAL PROCEDURE DPYSST(STRING S);
00300
00400 DTYO: COMPAT(1)
00500 IDPB A,DPYPTR
00600 HRRZ A,DPYPTR
00700 CAML A,BUFEND
00800 SETOM IGNORE
00900 GO @RETURN
01000
01100 DPYSST: POP SP,1
01200 POP SP,2
01300 SKIPGE IGNORE↔POPJ P,
01400 HRRZS 2 ;LENGTH
01500 JUMPLE 2,SSRET
01600 ILDB 3,1
01700 IDPB 3,DPYPTR
01800 SOJG 2,.-2
01900 SSRET: HRRZ 1,DPYPTR
02000 CAML 1,BUFEND
02100 SETOM IGNORE
02200 POPJ P,
00100 DPYBIG: COMPAT(1)
00200 MOVEI 3,INV+RV ;ZERO LENGTH RELATIVE-INVISIBLE VECTOR
00300 DPB 1,[POINT 3,3,27]
00400 GO LV2
00500 DPYBRT: COMPAT(1)
00600 MOVEI 3,INV+RV
00700 DPB 1,[POINT 3,3,24]
00800 GO LV2
00900 DPYCLR: SKIPL DPYFLG#
01000 DPYCLR
01100 MOVSI 777774
01200 DAC POGWD
01300 SETZM BUFHD
01400 POPJ P,
01500 DPYOUT: PUSHJ P,DPYPARS
01600 HRRZ B,DPYPTR
01700 SUB B,BUFHD
01800 ADDI B,1
01900 DAC B,BUFHD+1
02000 SH2: COMPAT(1)
02100 DPB A,[POINT 4,SH1,12]
02200 OR A,DPYFLG
02300 SKIPL A
02400 SH1: UPG BUFHD
02500 FALSE: MOVEI A,0
02600 GO @RETURN
02700
02800 CLRBFR: COMPAT(0)
02900 GO CLR2
03000
03100 DPYSET: SETZM DPYFLG
03200 COMPAT(1)
03300 ADDI 1,2
03400 DAC 1,BUFHD
03500 HRRZ 2,-3(1) ;SIZE
03600 ADDI 2,-3(1)
03700 SUBI 2,1
03800 SETZM IGNORE
03900 DAC 2,BUFEND
04000 CLR2: LAC A,BUFHD
04100 MOVEI B,1
04200 DAC B,1(A)
04300 MOVEI B,2(A)
04400 HRLI B,1(A)
04500 BLT B,@BUFEND ;SET DPY BUFFER TO NULL CHARACTER WORDS
04600 GO LV3
00100 HYDPOG: SETZM BUFHD+1
00200 GO SH2
00300
00400 DPYPARS: SKIPN 1,BUFHD
00500 POPJ P,
00600 LAC 2,DPYPTR
00700 DAC 2,-2(1)
00800 MOVEI 2,2(2)
00900 SUB 2,1
01000 DAC 2,-1(1)
01100 POPJ P,
01200
01300 DPYRESET: COMPAT(1)
01400 ADDI 1,2
01500 DAC 1,BUFHD
01600 HRRZ 2,-3(1)
01700 ADDI 2,-3(1)
01800 DAC 2,BUFEND
01900 HRRZ 1,-2(1)
02000 GO CLR2+1
02100
02200 INTERNAL DPYTYP,TYPLOC
02300 DPYTYP: SETZM DPYFLG
02400 COMPAT(3)
02500 SKIPGE DPYFLG
02600 GO @RETURN
02700 DPYPOS(1) ;POSITION
02800 DPB 2,[POINT 9,3,26]
02900 DPYSIZ (3)
03000 GO @RETURN
03100
03200 TYPLOC: SETZM DPYFLG
03300 COMPAT(2)
03400 SKIPGE DPYFLG
03500 GO @RETURN
03600 DPYPOS (1)
03700 SUB 1,2
03800 IDIVI 1,=23
03900 CAIG 1,2
04000 MOVEI 1,3
04100 DPYSIZ 1000-2(1)
04200 GO @RETURN
00100 INTERNAL PGSEL,GETPOG,RELPOG
00200 PGSEL: COMPAT(1)
00300 JUMPL 1,@RETURN
00400 SKIPL DPYFLG
00500 PGSEL 1
00600 GO @RETURN
00700
00800
00900 POGWD: XWD 777774,0
01000
01100 GETPOG: LAC POGWD
01200 JFFO .+2
01300 MOVNI 1,1
01400 ROT (1)
01500 TLZ 400000
01600 MOVN 2,1
01700 ROT(2)
01800 DAC POGWD
01900 POPJ P,
02000
02100 RELPOG: LAC 1,-1(P)
02200 LAC POGWD
02300 ROT (1)
02400 TLO 400000
02500 MOVN 2,1
02600 ROT(2)
02700 DAC POGWD
02800 GO HYDPOG
02900 IGNORE: 0
03000
03100 RETURN: 0
03200
03300
03400 INTERNAL DPYPTR;
03500 DPYPTR: 0
03600 BUFEND: 0
03700 BUFHD: 0
03800 0
00100 ;CLIPER - 2D LINE SEGMENT CLIPPER - AUGUST 1972.
00200
00300 DPYBUF: DPYBU.
00400 =1024↔1↔XWD 1,=1024
00500 DPYBU.: BLOCK 2000
00600
00700 INTERN MAG,SX,SY,SOX,SOY,DEL
00800 ;SOURCE WINDOW.
00900 SX: 0
01000 SY: 0
01100 SOX: 0
01200 SOY: 0
01300
01400 ;OBJECT WINDOW.
01500 OX: 0
01600 OY: 0
01700 MAG: 3.4
01750 DEL: 32.0
01800
01900 ;PSEUDO BEAM POSITION.
02000 XXX: 0
02100 YYY: 0
02200
02300
02400 DECLARE{XL,XH,YL,YH}
02500
02600 SUBR(CROP)
02700 BEGIN CLIPIN
02800 LAC 1,OX↔LAC MAG↔FMP SX↔FSB 1,0↔DAC 1,SOX
02900 LAC 1,OY↔LAC MAG↔FMP SY↔FSB 1,0↔DAC 1,SOY
03000
03100 LAC 1,OX↔LAC MAG↔FMP[155.0]↔FSB 1,0
03200 CAMG 1,[-510.0]↔LAC 1,[-510.0]↔DAC 1,XL
03300 LAC 1,OX↔LAC MAG↔FMP[155.0]↔FAD 1,0
03400 CAML 1,[ 510.0]↔LAC 1,[510.0]↔DAC 1,XH
03500
03600 LAC 1,OY↔LAC MAG↔FMP[115.0]↔FSB 1,0
03700 CAMG 1,[-470.0]↔LAC 1,[-470.0]↔DAC 1,YL
03800 LAC 1,OY↔LAC MAG↔FMP[115.0]↔FAD 1,0
03900 CAML 1,[ 470.0]↔LAC 1,[470.0]↔DAC 1,YH
04000
04100 POP0J
04200 BEND
04300
00100 SUBR(AI)
00200 BEGIN AI
00300 LAC ARG2↔FMP MAG↔FAD SOX↔DAC XXX
00400 LAC ARG1↔FMP MAG↔FAD SOY↔DAC YYY
00500 POP2J
00600 BEND
00700
00800 SUBR(AV)
00900 BEGIN AV
01000 GO .+5
01100 X1:0↔Y1:0↔X2:0↔Y2:0 ;FUCKING REFERENCE REALS.
01200 LAC XXX↔DAC X1
01300 LAC YYY↔DAC Y1
01400 LAC ARG2↔FMP MAG↔FAD SOX↔DAC XXX↔DAC X2
01500 LAC ARG1↔FMP MAG↔FAD SOY↔DAC YYY↔DAC Y2
01600 MOVEI X1↔PUSH 17,
01700 MOVEI Y1↔PUSH 17,
01800 MOVEI X2↔PUSH 17,
01900 MOVEI Y2↔PUSH 17,
02000 PUSHJ P,CLIP
02100 SKIPN 1↔POP2J
02200 LAC X1↔FIXX↔PUSH P,
02300 LAC Y1↔FIXX↔PUSH P,
02400 PUSHJ P,AIVECT
02500 LAC X2↔FIXX↔PUSH P,
02600 LAC Y2↔FIXX↔PUSH P,
02700 PUSHJ P,AVECT
02800 POP2J
02900 BEND
00100 GETXY: 0
00200
00300 CDR -1(1) ;COL TO X.
00400 SUBI =144*=64
00500 FSC 225↔PUSH P,
00600
00700 CAR 2,-1(1) ;ROW TO Y.
00800 MOVEI =108*=64
00900 SUB 0,2
01000 FSC 225↔PUSH P,
01100 GO @GETXY
01200
01300 SUBR DPYPGON
01400 BEGIN
01500 LAC 1,ARG1
01600 CAR 1,1(1)↔DAC 1,E0#
01700 CAR 1,1(1)↔JSR GETXY ↔ PUSHJ P,AI ; V0 ← CW(E0).
01800 LAC 1,E0↔CDR 1,1(1)↔DAC 1,V#
01900
02000 L1: JSR GETXY ↔ PUSHJ P,AV
02100 LAC 1,V
02200 CDR 1,1(1) ;E
02300 CAMN 1,E0↔POP1J
02400 CDR 1,1(1)
02500 DAC 1,V
02600 GO L1
02700 POP1J
02800 BEND
00100 SUBR(REFRESH)
00200 BEGIN
00300 EXTERN PGON0
00400 CALL(DPYSET,DPYBUF)
00500 PUSH P,[-=510]↔PUSH P,[-=470]↔PUSHJ P,AIVECT
00600 PUSH P,[ =510]↔PUSH P,[-=470]↔PUSHJ P,AVECT
00700 PUSH P,[ =510]↔PUSH P,[ =470]↔PUSHJ P,AVECT
00800 PUSH P,[-=510]↔PUSH P,[ =470]↔PUSHJ P,AVECT
00900 PUSH P,[-=510]↔PUSH P,[-=470]↔PUSHJ P,AVECT
01000 LAC 1,PGON0↔DAC 1,PGON#
01100 L1: CDR 1,2(1)
01200 DAC 1,PGON
01300 PUSH P,1↔PUSHJ P,DPYPGON
01400 LAC 1,PGON
01500 CAME 1,PGON0
01600 GO L1
01700 SETZ↔PUSH P,↔PUSHJ P,DPYOUT
01800 POP0J
01900 BEND
00100 ; FLG ← CLIP(X1,Y1,X2,Y2) RETURN TRUE WHEN PORTION IS VISIBLE.
00200 DECLARE{AAA,BBB,CCC,FLGO,FLGZ,AXH,AXL,BYH,BYL,QNE,QNW,QSW,QSE}
00300 SUBR(CLIP)
00400 BEGIN CLIP
00500 ACCUMULATORS{X1,Y1,X2,Y2,PDL}
00600 PTR←13
00700
00800 ;PICK 'EM UP;
00900 LAC X1,@ARG4↔LAC Y1,@ARG3
01000 LAC X2,@ARG2↔LAC Y2,@ARG1
01100 LACI PTR,PDL-1
01200
01300 ;SET NSEW BITS.
01400 SETZB 1
01500 CAMLE Y1,YH↔TRO 8↔CAMLE Y2,YH↔TRO 1,8; NORTH.
01600 CAMGE Y1,YL↔TRO 4↔CAMGE Y2,YL↔TRO 1,4; SOUTH.
01700 CAMLE X1,XH↔TRO 2↔CAMLE X2,XH↔TRO 1,2; EAST.
01800 CAMGE X1,XL↔TRO 1↔CAMGE X2,XL↔TRO 1,1; WEST.
01900
02000 ;EASY OUTSIDER EDGE.
02100 TRNE 0,(1)↔GO [OUTSIDE: SETZ 1,↔POP4J]
02200
02300 ;EASY INSIDER VERTICES.
02400 JUMPE 0,[PUSH PTR,X1↔PUSH PTR,Y1↔GO .+1]
02500 JUMPE 1,[PUSH PTR,X2↔PUSH PTR,Y2↔GO .+1]
02600 DEFINE DONE{CAMN PTR,[XWD 4,PDL+3]↔GO L}
02700 DONE
00100 ;COMPUTE EDGE COEFFICIENTS.
00200 LAC Y1↔FSBR Y2↔DAC AAA
00300 LAC X2↔FSBR X1↔DAC BBB
00400 LAC X2↔FMPR Y1↔MOVNM CCC
00500 LAC X1↔FMPR Y2↔FADRM CCC
00600
00700 ;PARTIAL PRODUCTS.
00800 LAC AAA↔FMPR XH↔DAC AXH
00900 LAC AAA↔FMPR XL↔DAC AXL
01000 LAC BBB↔FMPR YH↔DAC BYH
01100 LAC BBB↔FMPR YL↔DAC BYL
01200
01300 ;CORNER Q'S.
01400 SETOM FLGO↔SETZM FLGZ
01500 LAC AXH↔FADR BYH↔FADR CCC↔DAC QNE↔ANDM FLGO↔IORM FLGZ
01600 LAC AXL↔FADR BYH↔FADR CCC↔DAC QNW↔ANDM FLGO↔IORM FLGZ
01700 LAC AXL↔FADR BYL↔FADR CCC↔DAC QSW↔ANDM FLGO↔IORM FLGZ
01800 LAC AXH↔FADR BYL↔FADR CCC↔DAC QSE↔ANDM FLGO↔IORM FLGZ
01900
02000 ;HARD OUTSIDER CASES.
02100 SKIPGE FLGO↔GO OUTSIDE
02200 SKIPL FLGZ↔GO OUTSIDE
00100 ;XY-CLIPPER continued.
00200 ;NORTH BORDER CROSSING.
00300 LAC QNE↔XOR QNW↔SKIPL↔GO L2
00400 LAC Y1↔CAMGE Y2↔LAC Y2↔CAMG YH↔GO L2
00500 LAC BYH↔FADR CCC↔MOVNS↔FDVR AAA↔PUSH PTR,
00600 LAC YH↔PUSH PTR,
00700 DONE
00800
00900 ;SOUTH BORDER CROSSING.
01000 L2: LAC QSE↔XOR QSW↔SKIPL↔GO L3
01100 LAC Y1↔CAMLE Y2↔LAC Y2↔CAML YL↔GO L3
01200 LAC BYL↔FADR CCC↔MOVNS↔FDVR AAA↔PUSH PTR,
01300 LAC YL↔PUSH PTR,
01400 DONE
01500
01600 ;EAST BORDER CROSSING.
01700 L3: LAC QSE↔XOR QNE↔SKIPL↔GO L4
01800 LAC X1↔CAMGE X2↔LAC X2↔CAMG XH↔GO L4
01900 LAC XH↔PUSH PTR,
02000 LAC AXH↔FADR CCC↔MOVNS↔FDVR BBB↔PUSH PTR,
02100 DONE
02200
02300 ;WEST BORDER CROSSING.
02400 L4: LAC QSW↔XOR QNW↔SKIPL↔GO L5
02500 LAC X1↔CAMLE X2↔LAC X2↔CAML XL↔GO L5
02600 LAC XL↔PUSH PTR,
02700 LAC AXL↔FADR CCC↔MOVNS↔FDVR BBB↔PUSH PTR,
02800 DONE
02900
03000 ;STRANGE EXIT - NSEW BIT MARKING & EDGE COEF ARE INCONSISTENT.
03100 L5: OUTSTR[ASCIZ/2D CLIPPER FALL THRU !
03200 /]↔ GO OUTSIDER
03300
03400 ;VISIBLE PORTION EXIT.
03500 L: DAC X1+4,@ARG4↔DAC Y1+4,@ARG3
03600 DAC X2+4,@ARG2↔DAC Y2+4,@ARG1
03700 SETO 1,↔POP4J
03800 LIT
03900 BEND
00100 INTERN HISTO
00200
00300 HISTO: HISTO.
00400 =65
00500 1
00600 XWD -1,64
00700 HISTO.: BLOCK =68
00800
00900 ;DISPLAY HISTOGRAM.
01000 SUBR(DPYHIS)
01100 BEGIN DPYHIS
01200 CALL(DPYSET,DPYBUF)
01300 MOVEI 1,1
01400 CALL(DPYBIG,1)
01500 ;SCALE THE IMAGE TO ITS LARGEST COLUMN.
01600 SETZ
01700 LAC 1,HISTO↔HRLI 1,-100
01800 CAMGE 0,(1)↔LAC(1)↔AOBJN 1,.-2
01900 MOVE 1,[800.0]↔FSC 233↔FDV 1,0↔DAC 1,SY#
02000
02100 PUSH P,[=511]↔PUSH P,[-=400]↔PUSHJ P,AIVECT
02200 PUSH P,[-=511]↔PUSH P,[-=400]↔PUSHJ P,AVECT
02300
02400 LAC 13,HISTO↔HRLI 13,-100
02500 MOVEI =511↔DACN 10 ;X.
02600
02700 L: PUSH P,10↔ADDI 10,20
02800 LAC 11,(13)↔FSC 11,233↔FMP 11,SY↔FIX 11,233000
02900 SUBI 11,=400↔PUSH P,11
03000 PUSHJ P,AVECT
03100 CALL(AVECT,10,11)
03200 AOBJN 13,L
03300
03400 PUSH P,[=511]↔PUSH P,[-=400]↔PUSHJ P,AVECT
03500 PUSH P,[0]↔PUSHJ P,DPYOUT
03600 POP0J
03700 BEND
03800 END